home *** CD-ROM | disk | FTP | other *** search
/ Meeting Pearls 4 / Meeting Pearls Vol. IV (1996)(GTI - Schatztruhe)[!].iso / Pearls / dev / Language / CLisp / fd / asl-load.lsp < prev    next >
Lisp/Scheme  |  1996-08-08  |  1KB  |  42 lines
  1. ;;;; Use ASL filerequester to load a file
  2.  
  3. ;;; Show how library functions can be defined at compile-time only
  4. ;;; when using mlibcall and proper eval-when, all references are compiled in
  5.  
  6. (in-package "AFFI-DEMOS")
  7. (use-package "AFFI")
  8.  
  9. (eval-when (compile eval load)
  10.   (declare-library-base :AslBase "asl.library"))
  11.  
  12. ;;importing some function definitions
  13. (eval-when (eval compile)
  14.   (require-library-functions "asl.library"
  15.     :import '("AllocAslRequest" "FreeAslRequest" "AslRequest")) )
  16.  
  17. (defun AddPart2 (dir file)
  18.   (declare (type string dir file))
  19.   ;; pretend we don't know dos.library/AddPart()
  20.   (concatenate
  21.    'string
  22.    dir
  23.    (unless (zerop (length dir))
  24.            (unless (find (char dir (1- (length dir))) ":/") "/"))
  25.    file))
  26.  
  27. (defun asl-load (&rest keys &key &allow-other-keys)
  28.   (let ((file
  29.    (with-open-library ("asl.library")
  30.      (let ((filerequest (mlibcall AllocAslRequest 0 0))) ; type, tags
  31.        (when (nzero-pointer-p filerequest)
  32.          (unwind-protect
  33.               (when (mlibcall AslRequest filerequest 0)
  34.                 (let ((file (mem-read (mem-read filerequest '* 4) 'string))
  35.                       (dir  (mem-read (mem-read filerequest '* 8) 'string)))
  36.                   (unless (zerop (length file))
  37.                     (addpart2 dir file))))
  38.            (mlibcall FreeAslRequest filerequest)))))))
  39.     (when file                          ;didn't cancel
  40.       (apply #'load file keys))))
  41.  
  42.